home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Grab Bag
/
Shareware Grab Bag.iso
/
090
/
tzap210.arc
/
NWINDO.200
< prev
next >
Wrap
Text File
|
1985-09-08
|
14KB
|
320 lines
{**********************************************************************}
{* N W I N D O . 2 0 0 : New Windos Procedures *}
{* *}
{* Separate this into File NWINDO.200 *}
{**********************************************************************}
{ Kloned and Kludged by Lane.H.Ferris }
{ -- The Hunters Helper -- }
{ Original ideas by Michael A. Covington }
{ Requirements: IBM PC or close compatible. }
{----------------------------------------------------------------------}
Const
MaxWin = 4; { maximum number of Windows open at once }
InitDone :boolean = false ; { Initialization switch }
On = True ;
Off = False ;
VideoEnable = $08; { Video Signal Enable Bit }
Black :byte = 0; { Video Color Attributes }
Blue :byte = 1;
Green :byte = 2;
Cyan :byte = 3;
Red :byte = 4;
Magenta:byte = 5;
Yellow :byte = 6;
White :byte = 7;
Bright :byte = 8;
Blink :byte = 16;
BackGround : byte = 16 ;
Type
Imagetype = array [1..4000] of char; { Screen Image in the heap }
WinDimtype = record
x1,y1,x2,y2: integer
end;
Screens = record { Save Screen Information }
Image: Imagetype; { Saved screen Image }
Dim: WinDimtype; { Saved Window Dimensions }
x,y: integer; { Saved cursor position }
end;
Var
Win: { Global variable package }
record
Dim: WinDimtype; { Current Window Dimensions }
Depth: integer;
Stack: array[1..maxWin] of ^Screens;
end;
Crtmode :byte absolute $0040:$0049;
Crtwidth :byte absolute $0040:$004A;
Monobuffer :Imagetype absolute $B000:$0000;
Colorbuffer :Imagetype absolute $B800:$0000;
CrtAdapter :integer absolute $0040:$0063; { Current Display Adapter }
VideoMode :byte absolute $0040:$0065; { Video Port Mode byte }
Video_Buffer:integer; { Record the current Video}
Attr :byte;
Switch :boolean;
Delta,
Xtemp,Ytemp :integer;
{------------------------------------------------------------------}
{ Get Absolute postion of Cursor into parameters x,y }
{------------------------------------------------------------------}
Procedure Get_Abs_Cursor (var x,y :integer);
Var
Active_Page : byte absolute $0040:$0062; { Current Video Page Index}
Crt_Pages : array[0..7] of integer absolute $0040:$0050 ;
Begin
X := Crt_Pages[active_page]; { Get Cursor Position }
Y := Hi(X)+1; { Y get Row }
X := Lo(X)+1; { X gets Col position }
End;
{----------------------------------------------------------------------}
{ G e t _ A b s _ A t t r : Get current Text Attributes }
{----------------------------------------------------------------------}
Procedure Get_Abs_Attr(Var Byteval:byte);{ Get current text attribute }
Begin { keeping the textcolor. Not the }
Get_Abs_Cursor(x,y) ; { compiler colors. }
Byteval := { Get old Cursor attributes }
Mem[ Video_Buffer:((x-1 + (y-1) * 80 ) * 2)+1 ] ;
End; { Get_Abs_Attr }
{----------------------------------------------------------------------}
{ L o w V i d e o : Set Low intensity on Screen }
{----------------------------------------------------------------------}
Procedure LowVideo; { Change to Low Video intensity }
Var
Byteval :byte;
Begin { keeping the textcolor. Not the }
Get_Abs_Cursor(x,y) ; { compiler colors. }
Byteval := { Get old Cursor attributes }
Mem[ Video_Buffer:((x-1 + (y-1) * 80 ) * 2)+1 ] ;
TextColor(Byteval And $07); { Take Low nibble 0..15 }
End; { Low Video }
{----------------------------------------------------------------------}
{ N o r m V i d e o : Set Low intensity on Screen }
{----------------------------------------------------------------------}
Procedure NormVideo; { Change to Low Video intensity }
Var
Byteval :byte;
Begin { keeping the textcolor. Not the }
Get_Abs_Cursor(x,y) ; { compiler colors. }
Byteval := { Get old Cursor attributes }
Mem[ Video_Buffer:((x-1 + (y-1) * 80 ) * 2)+1 ] ;
TextColor((Byteval and $0F) Or Bright); { Take Low nibble 0..15 }
End; { Low Video }
{----------------------------------------------------------------------}
{ R e v e r s e V i d e o : Set Low intensity on Screen }
{----------------------------------------------------------------------}
Procedure ReverseVideo; { Change to Low Video intensity }
Var
Byteval :byte;
Begin { keeping the textcolor. Not the }
Get_Abs_Cursor(x,y) ; { compiler colors. }
Byteval := { Get old Cursor attributes }
Mem[ Video_Buffer:((x-1 + (y-1) * 80 ) * 2)+1 ] ;
{ Take high nibble 0..15 }
TextColor((Byteval div 16) or (Byteval and $08));
TextBackground(Byteval mod 16); { Take low nibble }
End; { Low Video }
{------------------------------------------------------------------}
{ Turn the Video On/Off to avoid Read/Write snow }
{------------------------------------------------------------------}
Procedure Video (Switch:boolean);
Begin
If (Switch = Off) then
Port[CrtAdapter+4] := (VideoMode - VideoEnable)
else Port[CrtAdapter+4] := (VideoMode or VideoEnable);
End;
{----------------------------------------------------------------------}
{ B l i n k : Turn the Video Blink Attribute On or Off }
{----------------------------------------------------------------------}
Procedure BlinkChar(OnOff :boolean); { Blink at cursor On|Off }
Var
Byteval :byte;
Begin { keeping the textcolor. Not the}
Get_Abs_Cursor(x,y) ; { compiler colors. }
Byteval := { Get old Cursor attributes }
Mem[ Video_Buffer:((x-1 + (y-1) * 80 ) * 2)+1 ] ;
If (OnOff)
then Byteval := Byteval Or $80 { Turn Blink On }
else Byteval := Byteval And $7F; { Turn blink Off }
Mem[Video_Buffer:((x-1+(y-1)*80)*2)+1] := Byteval;
End; {Procedure Blink }
{------------------------------------------------------------------}
{ InitWin Saves the Current (whole) Screen }
{------------------------------------------------------------------}
Procedure InitWin;
{ Records Initial Window Dimensions }
Begin
If CrtMode = 7 then
Video_Buffer := $B000 {Set Ptr to Monobuffer }
else Video_Buffer := $B800; { or Color Buffer }
with Win.Dim do
begin x1:=1; y1:=1; x2:=crtwidth; y2:=25 end;
Win.Depth:=0;
InitDone := True ; { Show initialization Done }
end;
{------------------------------------------------------------------}
{ BoxWin Draws a Box around the current Window }
{------------------------------------------------------------------}
procedure BoxWin(x1,y1,x2,y2:integer; Attr:byte);
{ Draws a box, fills it with blanks, and makes it the current }
{ Window. Dimensions given are for the box; actual Window is }
{ one unit smaller in each direction. }
{ This routine can be used separately from the rest of the }
{ removable Window package. }
var
x,y : integer;
begin
Window(1,1,80,25);
TextColor((Attr Mod 16) or Bright) ;
TextBackground(Attr Div 16);
{ Top }
gotoxy(x1,y1); { Windo Origin }
Write( chr(213) ); { Top Left Corner }
For x:=x1+1 to x2-1 do { Top Bar }
Write( chr(205));
Write( chr(184) ); { Top Right Corner
{ Sides }
for y:=y1+1 to y2-1 do
begin
gotoxy(x1,y); { Left Side Bar }
write( chr(179) );
gotoxy(X2,y) ; { Right Side Bar }
write( chr(179) );
end;
{ Bottom }
gotoxy(x1,y2); { Bottom Left Corner }
write( chr(212) );
for x:=x1+1 to x2-1 do { Bottom Bar }
write( chr(205) );
write( chr(190) ); { Bottom Right Corner }
{ Make it the current Window }
Window(x1+1,y1+1,x2-1,y2-1);
gotoxy(1,1) ;
TextColor( Attr mod 16); { Take Low nibble 0..15 }
TextBackground ( Attr Div 16); { Take High nibble 0..9 }
ClrScr;
end;
{------------------------------------------------------------------}
{ MkWin Make a Window }
{------------------------------------------------------------------}
procedure MkWin(x1,y1,x2,y2 :integer; attr :byte);
{ Create a removable Window }
begin
If (InitDone = false) then { Initialize if not done yet }
InitWin;
with Win do Depth:=Depth+1; { Increment Stack pointer }
if Win.Depth>maxWin then
begin
writeln(^G,' Windows nested too deep ');
halt
end;
{-------------------------------------}
{ Save contents of screen }
{-------------------------------------}
Video(Off) ; { Turn off Video to avoid Snow }
With Win do
Begin
New(Stack[Depth]); { Allocate Current Screen to Heap }
If CrtMode = 7 then
Stack[Depth]^.Image := monobuffer { set pointer to it }
else
Stack[Depth]^.Image := colorbuffer ;
End ;
Video(On) ; { Turn the Video back on }
With Win do
Begin { Save Screen Dimentions }
Stack[Depth]^.Dim := Dim;
Stack[Win.Depth]^.x := wherex; { Save Cursor Position }
Stack[Win.Depth]^.y := wherey;
End ;
{ Validate the Window Placement}
If (X2 > 80) then { If off right of screen }
begin
Delta := X2 - 80; { Overflow off right margin }
X1 := X1 - Delta; { Move Left window edge }
X2 := X2 - Delta; { Move Right edge on 80 }
end;
If (Y2 > 24) then { If off bottom screen }
begin
Delta := Y2 - 24; { Overflow off right margin }
Y1 := Y1 - Delta ; { Move Top edge up }
Y2 := Y2 - Delta ; { Move Bottom 24 }
end;
If (X1 < 1) then X1 := 1; { Validate left side of window }
If (Y1 < 1) then Y1 := 1;
BoxWin(x1,y1,x2,y2,Attr); { Create the New window }
Win.Dim.x1 := x1+1;
Win.Dim.y1 := y1+1; { Allow for margins }
Win.Dim.x2 := x2-1;
Win.Dim.y2 := y2-1;
end;
{------------------------------------------------------------------}
{ Remove Window }
{------------------------------------------------------------------}
{ Remove the most recently created removable Window }
{ Restore screen contents, Window Dimensions, and }
{ position of cursor. }
Procedure RmWin;
Var
Tempbyte : byte;
Begin
Video(Off);
With Win do
Begin { Restore next Screen }
If crtmode = 7 then
monobuffer := Stack[Depth]^.Image
else
colorbuffer := Stack[Depth]^.Image;
Dispose(Stack[Depth]); { Remove Screen from Heap }
Video(On);
With Win do { Re-instate the Sub-Window }
Begin { Position the old cursor }
Dim := Stack[Depth]^.Dim;
Window(Dim.x1,Dim.y1,Dim.x2,Dim.y2);
gotoxy(Stack[Depth]^.x,Stack[Depth]^.y);
end;
Get_Abs_Cursor(x,y) ; { New Cursor Position }
Tempbyte := { Get old Cursor attributes }
Mem[ Video_Buffer:((x-1 + (y-1) * 80 ) * 2)+1 ];
TextColor( Tempbyte And $0F ); { Take Low nibble 0..15}
TextBackground ( Tempbyte Div 16); { Take High nibble 0..9 }
Depth := Depth - 1
end ;
end;
{......................................................................}